LOGIC Apps

home *** CD-ROM | disk | FTP | other *** search

/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO102.dsk / COMPRESSOR / COMPRESSOR.S.txt < prev

Wrap

Text File | 2012-02-16 | 49KB | 1,660 lines

******************************** * * * Compressor * * * * By Karl Bunker * * * ******************************** KEEP COMPRESSOR ORG $803 MCOPY /HD/ORCA/MACROS/MACROS.8.BIT MAIN START 65816 OFF 65C02 OFF MSB ON JMP BEGIN *=============================== * Labels *=============================== HIMEM EQU $73 COUT EQU $FDED COUT1 EQU $FDF0 CROUT EQU $FD8E Return print PRBYTE EQU $FDDA VTB EQU $FC22 PTR EQU $06 "Primary" pointers AUX_PTR EQU $08 "Auxiliary" pointers SCRTCH EQU $D64B Execute Applesoft "NEW" CLEAR EQU $D66C Applesoft "CLEAR" stack KEYBD EQU $C000 STROBE EQU $C010 GETLN EQU $FD6F Input line RDKEY EQU $FD0C Read key INBUF EQU $200 MONHOME EQU $FC58 PRBL2 EQU $F94A CLREOF EQU $FC42 Clear to bottom page DOSCMD EQU $BE03 Basic.System command interpreter UP EQU $FC1A Cursor up 1 line MLI EQU $BF00 BELL EQU $FBDD ESC EQU $9B TXT EQU $04 AWP EQU $1A COM EQU $F8 *======================================= * Subroutines for file openning, etc. *======================================= *--------------------------------------- * Increment pointers subroutines *--------------------------------------- INC_PTR INC PTR Inc primary pointers BNE INCP_DN INC PTR+1 INCP_DN RTS INC_APTR INC AUX_PTR Inc auxiliary pointers BNE INCA_DN INC AUX_PTR+1 INCA_DN RTS *------------------------------- * Print *------------------------------- PRINT PLA STA AUX_PTR PLA STA AUX_PTR+1 LDY #0 PRNT_LUP JSR INC_APTR LDA (AUX_PTR),Y BEQ PR_FNSH JSR COUT JMP PRNT_LUP PR_FNSH LDA AUX_PTR+1 PHA LDA AUX_PTR PHA RTS *------------------------------- * HOME *------------------------------- HOME LDA #$8C JMP COUT *------------------------------- * VTAB routine *------------------------------- VTAB_RTN STA $25 JMP VTB *------------------------------- * Clear screen bottom *------------------------------- CLR_BTM LDA #$8B JMP COUT *------------------------------- * Input line *------------------------------- KEYPRESS ANOP POKE READ_1,$FF BNE GET_CHR (always) INPUT ANOP LDX #0 STX READ_1 GET_CHR BIT IIPLS If II+ (Videoterm), use BPL GET_CHR2 keyboard-read, rather than LDA KEYBD RDKEY. BPL GET_CHR STA STROBE BMI CHR_GOT GET_CHR2 JSR RDKEY CHR_GOT BIT READ_1 If read-1-keypress flag set, BPL CHR_GOT2 return now. RTS CHR_GOT2 CMP #ESC Esc? BNE NOT_ESC INP_QUIT RTS If so, return with it NOT_ESC CMP #$8D Return? BEQ INP_DUN CMP #$88 Left arrow? BEQ BK_SPC CMP #$FF Delete? BEQ BK_SPC CMP #$95 Right arrow? BEQ FWD_SPC CMP INP_MINC Other control char.? BCC GET_CHR CPX #48 Max. input length=48 BCS GET_CHR INX Regular character CMP #'a' If lower case, convert BCC STO_CHR AND #$DF STO_CHR STA INP_BUF,X STX INP_BUF BNE PRNT_CHR BK_SPC LDA #$88 If <delete> force left-arrow CPX #1 BCC GET_CHR DEX JMP PRNT_CHR FWD_SPC CPX #48 BCS GET_CHR INX STX INP_BUF INC 1403 BNE GET_CHR PRNT_CHR JSR COUT JMP GET_CHR INP_DUN STX INP_BUF CPX #0 BEQ INP_OUT2 INP_OUT LDA #$9D Return, clear rest of line JSR COUT INP_OUT2 JMP CROUT If return alone, don't erase *------------------------------- * Get_File_Info *------------------------------- G_F_I LDA #$A Set up parm list for GFI STA PARMLST LDA #<INP_BUF Low byte pathname address STA PARMLST+1 LDA #>INP_BUF High byte pathname address STA PARMLST+2 JSR MLI DC H'C4' Code for Get_file_info DC A'PARMLST' RTS Bring any error back *------------------------------- * Print file type *------------------------------- PRNT_TYP ANOP TAB80 1 LDA FILE_TYP CMP #TXT BEQ PRNT_TXT CMP #COM BEQ PRNT_COM JSR PRINT DC C'- AppleWorks word processor file; ' DC H'00' JMP PRTP_DN PRNT_COM JSR PRINT DC C'- Compressed file; ',H'00' JMP PRTP_DN PRNT_TXT JSR PRINT DC C'- ASCII text file; ',H'00' PRTP_DN ANOP Fall through . . . *------------------------------- * Print number of blocks *------------------------------- POKE LDNG_DGT,0 Init leading digit flag LDX #3 PR_DGTLP LDY #'0' INC_DGT LDA PARMLST+8 Low byte, blocks used CMP PRS_TENL,X Two-byte compare/subtract of LDA PARMLST+9 blocks used with power of 10 SBC PRS_TENH,X BCC PR_DIGIT Remainder < power of 10 STA PARMLST+9 Store hi-byte remainder LDA PARMLST+8 SBC PRS_TENL,X Get & store lo-byte remainder STA PARMLST+8 INY Inc ASCII digit BNE INC_DGT PR_DIGIT TYA CMP #'0' BNE PR_DGT2 BIT LDNG_DGT Is this "0" a leading "0"? BPL TO_DGTLP If so, don't print it PR_DGT2 STA LDNG_DGT Set "leading 0" flag JSR COUT TO_DGTLP DEX Dec X for next power of ten BPL PR_DGTLP Until 4 #'s printed/skipped LDA PARMLST+8 ORA #'0' Convert remainder to ASCII JSR COUT JSR PRINT DC C' blocks -',H'00' RTS PRS_TENH DC I1>'10,100,1000,10000' PRS_TENL DC I1<'10,100,1000,10000' *------------------------------- * Open source file *------------------------------- OPEN_SRC ANOP LDA #<SRC_NAM STA OPEN_PL+1 LDA #>SRC_NAM STA OPEN_PL+2 JSR MLI DC H'C8' Code for Open DC A'OPEN_PL' RTS Bring any error back *------------------------------- * Open object file *------------------------------- OPEN_OBJ ANOP LDA #<INP_BUF STA OPEN_PL+1 LDA #>INP_BUF STA OPEN_PL+2 JSR MLI DC H'C8' Code for open DC A'OPEN_PL' RTS Bring any error back *------------------------------- * Get_mark subroutine *------------------------------- GET_MARK JSR MLI DC H'CF' Code for get_mark DC A'MARK_PL' BEQ GTMK_OK JMP ERR_HAND GTMK_OK RTS Return *------------------------------- * Set_Mark subroutine *------------------------------- SET_MARK JSR MLI DC H'CE' Code for set_mark DC A'MARK_PL' BEQ SET_OK No error JMP ERR_HAND SET_OK RTS *------------------------------- * Read for segmented reads *------------------------------- SEG_READ ANOP JSR GET_MARK Get & save object file mark LDA MARK_PL+2 STA OBJ_MARK LDA MARK_PL+3 STA OBJ_MARK+1 LDA MARK_PL+4 STA OBJ_MARK+2 JSR CLOSE Then close it LDA YES_SWAP Are we doing swaps? BNE SWAPS If so, prompt before opening JSR OPEN_SRC Try to open source BEQ NO_SWAP No error; both disks on-line CMP #$45 BEQ SWAPS Vol. not found; disk swapped JMP ERR_HAND Other error NO_SWAP POKE NO_SWAPS,1 JMP ROPN_OK Source open; go set mark SWAPS ANOP POKE YES_SWAP,1 JSR CLR_BTM VTAB 20 TAB80 1 JSR PRINT DC C'Insert source disk, press <return> ' DC H'00' JSR KEYPRESS CMP #$8D BEQ ROPN_SRC CMP #ESC BNE SWAPS JMP INIT <esc> pressed; start over ROPN_SRC JSR UP JSR CLR_BTM Clear screen bottom JSR OPEN_SRC Try to open source again BEQ ROPN_OK CMP #$45 BEQ SWAPS Vol. not found; re-prompt JMP ERR_HAND ROPN_OK LDA SRC_MARK STA MARK_PL+2 LDA SRC_MARK+1 STA MARK_PL+3 LDA SRC_MARK+2 STA MARK_PL+4 JSR SET_MARK JSR RD_FILE LDA NO_SWAPS If we got here from NO_SWAP, BNE ROP_OBJ2 skip next prompt. SWAPS2 VTAB 20 TAB80 1 JSR PRINT DC C'Insert object disk, press <return> ' DC H'00' JSR KEYPRESS CMP #$8D BEQ ROPN_OBJ CMP #ESC BNE SWAPS2 JMP INIT <esc> pressed; start over ROPN_OBJ JSR UP JSR CLR_BTM Clear screen bottom ROP_OBJ2 JSR OPEN_OBJ Try to open object BEQ ROPNO_OK CMP #$45 BEQ SWAPS2 Vol. not found; re-prompt JMP ERR_HAND Other error ROPNO_OK LDA OBJ_MARK STA MARK_PL+2 LDA OBJ_MARK+1 STA MARK_PL+3 LDA OBJ_MARK+2 STA MARK_PL+4 Reset object file mark, and JMP SET_MARK return. *------------------------------- * Read file into main buffer *------------------------------- RD_FILE ANOP JSR MLI DC H'CA' Code for Read DC A'READ_PL' BEQ READ_OK No error JMP ERR_HAND READ_OK ANOP *--------------------------------------- * Compare request_count to trans_count *--------------------------------------- COMPARE ANOP LDA READ_PL+6 Save TRANS_COUNT for DECOMP STA READ_IN LDA READ_PL+7 STA READ_IN+1 LDA READ_PL+7 High byte trans_count CMP READ_PL+5 High byte request_count BCC SMALLER LDA READ_PL+6 Low bytes; if all bytes equal CMP READ_PL+4 then file (probably) bigger BCC SMALLER than buffer. LDA #1 Trans = requ., so there must * be more text 'ahead' of buf. BNE CMPDONE (always) SMALLER LDA #0 Trans<requ; file smaller CMPDONE STA MR_AHED Set flags; more ahead ORA SEGMENTS and SEGMENTS (SEGMENTS stays STA SEGMENTS set after MR_AHED is 0) JSR GET_MARK Get and save source mark LDA MARK_PL+2 STA SRC_MARK LDA MARK_PL+3 STA SRC_MARK+1 LDA MARK_PL+4 STA SRC_MARK+2 JSR CLOSE *------------------------------- * Poke zero at end of text, * check if AWP_CON needed *------------------------------- CLC LDA READ_PL+6 Low byte trans_count ADC #<MAINBUF Low byte address of main buf STA PTR LDA READ_PL+7 High byte trans_count ADC #>MAINBUF High byte buffer address STA PTR+1 LDY #0 One past end of text TYA STA (PTR),Y LDA #<MAINBUF Set pointers to main buffer STA PTR LDA #>MAINBUF STA PTR+1 LDA FILE_TYP If file is AWP, go convert CMP #AWP BNE RD_DONE JSR AWP_CON RD_DONE RTS *------------------------------- * Unlock, destroy object file *------------------------------- UNL_DES ANOP JSR G_F_I Do a Get_File_Info LDA #7 Re-set up parm list for SFI STA PARMLST LDA #$C3 Set access to "unlocked" STA PARMLST+3 JSR MLI DC H'C3' Code for Set_File_Info DC A'PARMLST' Errors will be caught below DESTROY JSR MLI DC H'C1' Code for Destroy DC A'DEST_PL' BEQ DESTROYD No error CMP #$46 File not there to be BEQ DESTROYD destroyed? That's ok; cont. CMP #$45 BEQ DESTROYD JMP ERR_HAND DESTROYD RTS *------------------------------- * Error handler for Src & Obj *------------------------------- ERR_HAND ANOP STA STORE JSR CLEAR Clean up stack TAB80 1 JSR CLR_BTM LDA STORE CMP #$44 Any of the BCC BAD_PTH Path not found errors? CMP #$47 BCS BAD_PTH JSR PRINT DC C'Can''t find ',H'00' LDA STORE CMP #$44 BNE VOL_ERR JSR PRINT DC C'that directory.',H'00' JMP TRY_AGN VOL_ERR CMP #$45 BNE FIL_ERR JSR PRINT DC C'that volume.',H'00' JMP TRY_AGN FIL_ERR JSR PRINT DC C'the source file.',H'00' JMP TRY_AGN BAD_PTH CMP #$40 Bad pathname BNE WRT_PRTC JSR PRINT DC C'Invalid pathname.',H'00' JMP TRY_AGN WRT_PRTC CMP #$2B BNE VOL_FULL JSR PRINT DC C'Disk is write-protected.' DC H'00' JMP TRY_AGN VOL_FULL CMP #$48 Volume full error? BNE OTHR_ERR JSR CLOSE Have to close before JSR DESTROY destroying. JSR PRINT DC C'Not enough room on that volume for' DC C' the object file.',H'00' LDA SEGMENTS Are we working on a mult-seg BEQ VOLFULDN file? If so, have TRY_AGN go POKE SRC_OBJ,0 back to re-open source file. VOLFULDN JMP TRY_AGN OTHR_ERR ANOP JSR PRINT Errors not covered elsewhere * are caught here. DC H'8D',C' ProDOS MLI error #$',H'00' LDA STORE JSR PRBYTE JSR CROUT Print a return JMP BAILOUT *------------------------------- * Try again or quit? *------------------------------- TRY_AGN JSR PRINT DC H'8D',C' Press <return> to try again,' DC C' <esc> to quit. ',H'00' TRY_GET JSR KEYPRESS CMP #$8D BEQ DO_TRY CMP #ESC <esc>? BNE TRY_GET JMP STRTPRMT Go to 'RUN STARTUP?' prompt DO_TRY JSR UP LDA SRC_OBJ <return>, try again CMP #'O' coming from GET_OBJ? BEQ BAK2OBJ If so, go back to GET_SRC2 LDA SEGMENTS If not, and error inturpted BEQ BAK2SRC multi-seg read, go to INIT. JMP INIT BAK2SRC JSR UP If not in a multi-seg read, JSR UP leave screen in case CAT JMP GET_SRC2 done. BAK2OBJ POKE ERROR,1 Set flag for screen clear JMP GET_OBJ *---------------------------------- * Disaster or normal end; bail out *---------------------------------- BAILOUT JSR CLR_BTM JSR CLOSE LDA #$8D JSR COUT CLC Clear carry for Applesoft JMP $3D0 Enter Basic *------------------------------- * Close File(s) *------------------------------- CLOSE JSR MLI DC H'CC' Code for close DC A'CLOSE_PL' * Note: no allowance for MLI RTS error; could cause inf. loop. ******************************** * BEGIN ******************************** *------------------------------- * Some light housekeeping *------------------------------- BEGIN ANOP LDA #1 Do a get_prefix to see if STA PARMLST ProDOS has a prefix. LDA HIMEM STA PARMLST+1 Have get_prefix write prfix LDA HIMEM+1 into I.O. buffer. STA PARMLST+2 JSR MLI DC H'C7' Code for get_prefix DC A'PARMLST' BEQ GP_OK No error JMP OTHR_ERR GP_OK LDY #0 LDA (HIMEM),Y Get length byte of the prfix BNE GOTPRFX If not 0, ProDOS has a prfix LDA $BE3C Active disk slot number ORA #'0' Convert to ASCII STA PREFX+8 Put into prefix string LDA $BE3D Active disk drive number ORA #'0' To ASCII STA PREFX+11 Into string LDX #0 READPRFX LDA PREFX,X Execute a "prefix,s#,d#" to STA INBUF,X tell ProDOS the prefix INX CPX #13 BNE READPRFX JSR DOSCMD BCC GOTPRFX No error JMP $BE0C Basic.System error handler GOTPRFX ANOP JSR SCRTCH In case any BASIC program, * zonk it out. JSR CLOSE In case anything open, close *=============================== * Calculate main buffer size *=============================== SEC LDA HIMEM STA OPEN_PL+3 SBC #2 STA BUF_END LDA HIMEM+1 STA OPEN_PL+4 SBC #0 STA BUF_END+1 SEC LDA BUF_END SBC #<MAINBUF STA READ_PL+4 Put amount of free room LDA BUF_END+1 into READ Parm list, SBC #>MAINBUF HIMEM into OPEN Parm list. STA READ_PL+5 *=============================== * Init. and display screens *=============================== LDX #0 INP_PR3 LDA PR3,X Read 'PR#3' into buffer STA INBUF,X INX CPX #5 BNE INP_PR3 JSR DOSCMD Call Basic.System interpreter BCC INIT JSR PRINT If error . . . DC H'8D' DC C'REQUIRES 80 COLUMN DISPLAY',H'8D 00' CLC RTS . . . and exit INIT ANOP JSR CLOSE LDA #0 STA MR_AHED STA ERROR STA YES_SWAP STA NO_SWAPS STA SEGMENTS LDA 64435 CMP #6 BEQ NOTIIPLS POKE IIPLS,$FF NOTIIPLS ANOP DISPLAY LDA #' ' JSR COUT Activate 80 col. firmware JSR HOME POKE CATFLG,0 *------------------------------- * Box *------------------------------- BIT IIPLS If II+ or un-enhanced IIe, BMI NO_BOX don't print MouseText box. LDA $FBC0 CMP #$EA BEQ NO_BOX LDA #$1B JSR COUT MouseText on VTAB 3 TAB80 20 LDX #39 TOP LDA #$4C MouseText top line JSR COUT DEX BPL TOP LDX #6 SIDES TAB80 20 LDA #$5A Left side JSR COUT TAB80 60 LDA #$5F Right side JSR COUT JSR CROUT DEX BPL SIDES LDA #$18 JSR COUT1 MouseText off VTAB 9 TAB80 21 LDX #38 BTTM LDA #'_' Bottom line JSR COUT DEX BPL BTTM NO_BOX ANOP *------------------------------- * Title *------------------------------- VTAB 4 TAB80 35 JSR PRINT DC C'Compressor',H'00' VTAB 6 TAB80 33 JSR PRINT DC C'By Karl Bunker',H'00' VTAB 8 TAB80 26 JSR PRINT DC C'This program is Public Domain.',H'00' *------------------------------- * Get source pathname *------------------------------- GET_SRC ANOP VTAB 13 GET_SRC2 JSR CLR_BTM To clear error mssg., etc. LDA #0 STA SRC_OBJ STA SEGMENTS JSR PRINT DC H'8D 8D' DC C' Enter "?" for info. on this program' DC H'8D',C' Enter "C" to catalog',H'00' JSR UP JSR UP TAB80 1 JSR PRINT DC C'Pathname of your source file: ',H'00' DISPSUB NOP An RTS may be inserted here LDA #'.' STA INP_MINC JSR INPUT CMP #ESC BEQ TO_QUIT JSR CLR_BTM Erase "enter '?' - " CPX #1 BNE TO_LOAD LDA INP_BUF+1 CMP #'?' BEQ TO_INFO CMP #'C' BEQ CAT TO_LOAD JMP LOAD_SRC Go load source file TO_INFO JMP INFO TO_QUIT JMP STRTPRMT Go to 'STARTUP' prompt TO_DISP JMP DISPLAY Used by CAT below *------------------------------- * Catalog *------------------------------- CAT POKE CATFLG,1 Set cat flag; screen cleared JSR HOME VTAB 5 JSR PRINT DC C' Enter pathname of directory to catalog: ' DC H'00' LDA #',' STA INP_MINC JSR INPUT CMP #ESC BEQ TO_DISP INX LDA #$8D STA INP_BUF,X TXA CLC ADC #7 Add shift of 7 to Y for TAY "CATALOG" CAT_SHFT LDA INP_BUF,X STA INBUF,Y DEY DEX BNE CAT_SHFT INPCAT LDA CTLG,X Read 'catalog' into buffer STA INBUF,X INX CPX #8 BNE INPCAT JSR DOSCMD Call Basic.System interpreter BCC CATDONE JSR $BE0C Basic.System error handler JSR PRINT DC H'8D' DC C'Press <return> to try again; ' DC C'<esc> to quit. ',H'00' CAT_GET JSR KEYPRESS CMP #$8D BEQ CATAGN CMP #ESC <esc>? BNE CAT_GET JMP STRTPRMT Go to 'STARTUP' prompt CATAGN JMP CAT CATDONE JSR UP JMP GET_SRC2 *------------------------------- * Info text *------------------------------- INFO ANOP TAB80 1 VTAB 10 In case screen messed up by JSR CLR_BTM catalog, clear some room. JSR PRINT DC H'8D' DC C' Compressor, version 1.13',H'8D' DC C' Compressor is a program which will read' DC C' an ASCII text or AppleWorks AWP file',H'8D' DC C' and convert it into a compressed-format' DC C' file which will be about 30% smaller',H'8D' DC C' than the source file. This compressed file' DC C' can then be viewed or printed with',H'8D' DC C' the utility program "Dogpaw" (version 3.0' DC C' or later). Compressor can also',H'8D' DC C' decompress its compressed files, converting' DC C' them to ASCII text files. Dogpaw,',H'8D' DC C' and full information on Compressor can' DC C' be found on the /Doc.Stuff/ disk. If',H'8D' DC C' you don''t have this disk, you can get' DC C' it by sending me a blank disk and',H'8D' DC C' return postage, or $3.00.',H'8D 8D' DC C' Karl Bunker, 321 S. Huntington Ave.,' DC C' Boston, MA 02130',H'8D8D' DC C' Press <return> ',H'00' JSR GETLN JMP DISPLAY *=============================== * Load source file *=============================== *--------------------------------------- * If screen cleared for CAT, reprint it *--------------------------------------- LOAD_SRC ANOP LDA CATFLG BEQ NOT_CLD Screen not cleared LDA #$60 STA DISPSUB Make display a subroutine JSR DISPLAY LDA #$EA STA DISPSUB Put NOP back LDX #1 DISP_LUP LDA INP_BUF,X Reprint file name after CMP #' ' prompt. BCC DIS_SKIP JSR COUT DIS_SKIP INX CPX INP_BUF BCC DISP_LUP BEQ DISP_LUP JSR CLR_BTM JSR CROUT NOT_CLD ANOP *------------------------------- * Get & check file info *------------------------------- LDX INP_BUF SAVE_SRC LDA INP_BUF,X Source name to SRC_NAM STA SRC_NAM,X DEX BPL SAVE_SRC JSR G_F_I Go Get_File_Info BEQ TYPE_ERR No ProDOS error; check type JMP ERR_HAND Handle ProDOS errors TYPE_ERR LDA PARMLST+4 CMP #4 Text file? BEQ FILE_OK CMP #$1A AWP file? BEQ FILE_OK CMP #$F8 Compressed file? BEQ FILE_OK SEC SBC #$AC CMP #4 SRC file? BEQ FILE_OK JSR PRINT DC C' File isn''t TXT, AWP or compressed type.',H'00' JMP TRY_AGN FILE_OK STA FILE_TYP JSR PRNT_TYP Print file type & size *------------------------------- * Open & read file *------------------------------- OPNFIL JSR OPEN_SRC BEQ OPEN_OK No error JMP ERR_HAND MLI problem OPEN_OK LDA FILE_TYP If file is an AWP, go do a CMP #AWP set mark. BNE GO_READ JSR AWP_SET GO_READ JSR RD_FILE *------------------------------- * Get object pathname *------------------------------- GET_OBJ1 ANOP LDA INP_BUF Save length byte of source STA STORE file name. LDA #'O' STA SRC_OBJ Set flag for error handler VTAB 17 JSR CROUT LDA FILE_TYP CMP #COM BNE NOT_COM LDX STORE If source file is compressed LDA INP_BUF,X Length byte of source to X CMP #'C' See if last 2 char.s are ".C" BNE GET_OBJ LDA INP_BUF-1,X If not, don't print prompt CMP #'.' for default. BNE GET_OBJ DEX DEX STX INP_BUF If so, take 2 from length STX STORE of pathname to delete ".C" BNE DEF_PRMT (always) NOT_COM LDX STORE Default pathname for INX compressed files; add ".C". INX STX INP_BUF STX STORE LDA #'.' STA INP_BUF-1,X LDA #'C' STA INP_BUF,X DEF_PRMT LDX #0 Print default file name TAB80 27 and prompt. DIS_LUP2 LDA INP_BUF+1,X JSR COUT INX CPX INP_BUF BCC DIS_LUP2 JSR PRINT DC H'8D',C' <Return> to accept',H'00' GET_OBJ VTAB 18 TAB80 1 OBJ_PRMT JSR PRINT DC C'Pathname for object file: ',H'00' LDA ERROR If error in name, erase it BEQ OBJ_INP JSR CLR_BTM POKE ERROR,0 BEQ GET_OBJ OBJ_INP LDA #'.' STA INP_MINC JSR INPUT CMP #ESC BEQ TO_INIT JSR CLR_BTM Erase "<Return> to - " TXA If name entered, use it BNE DES_CRE LDA STORE X=0; return pressed; put STA INP_BUF length byte ahead of name. BNE DES_CRE2 (always) TO_INIT JMP INIT Esc pressed; back to start *------------------------------- * Create object file *------------------------------- DES_CRE ANOP LDX INP_BUF CMP_OBJ LDA INP_BUF,X Compare object name with CMP SRC_NAM,X source. BNE DES_CRE2 DEX BPL CMP_OBJ If they're the same . . . JSR PRINT DC H'8D',C' Can''t use the same name' DC C' for the object file.',H'00' JMP TRY_AGN DES_CRE2 ANOP LDA #0 STA CREAT_PL+8 Zero out time & date bytes STA CREAT_PL+9 STA CREAT_PL+$A STA CREAT_PL+$B LDA #$F8 A "user defined" file type CMP FILE_TYP If source file is com- BNE SET_TYPE pressed, make object text. LDA #$04 SET_TYPE STA CREAT_PL+4 JSR MLI DC H'C0' Code for Create DC A'CREAT_PL' BEQ OBJ_REDY No error CMP #$47 File with that name exists? BEQ DES_PRMT JMP ERR_HAND DES_PRMT JSR PRINT DC H'8D',C' A file with that name ' DC C'already exists; o.k. to overwrite' DC C' it? Y/N Y',H'08 00' JSR KEYPRESS CMP #$8D Return = Yes BEQ KILLIT AND #$DF CMP #'Y' BNE TO_GTOBJ Not o.k. to destroy KILLIT JSR UP JSR CLR_BTM Erase prompt JSR UNL_DES Unlock & destroy file JMP DES_CRE2 TO_GTOBJ POKE ERROR,1 Set flag to clear screen JMP GET_OBJ *------------------------------- * Open object file; check if * compressing or decompressing *------------------------------- OBJ_REDY ANOP JSR OPEN_OBJ Go open object file BEQ OPOBJ_OK No error JMP ERR_HAND OPOBJ_OK ANOP LDA FILE_TYP If compressed file, go to CMP #COM decompress routine. BNE COMP_TXT JMP DECOMP ******************************** * Main program; Compression ******************************** COMP_TXT ANOP LDA #0 STA LETR_NUM TAX TAY JSR GET_CHAR Get first character JSR CODABL See if it's codable CMP #32 Has it been converted? BCS MAIN_LUP LDA #0 If so, the first byte into STA OBJ_BUF,X the object file is a 0. INX MAIN_LUP ANOP POKE FROM_ML,$FF Flag: coming from MAIN_LUP JSR GET_CHAR JSR CODABL CMP #32 Has it been converted? BCS UN_CODED INC LETR_NUM Char. codable; inc. counter STA STOREC LDA LETR_NUM Working on letter 1, 2 or 3? CMP #2 PHP POKE FROM_ML,0 LDA STOREC Byte back to A for wrk below PLP BCC LETR_1 BEQ LETR_2 BCS LETR_3 LETR_1 ASL A Shift byte 3 bits left ASL A ASL A STA WRK_BYT1 JSR INC_PTR BNE MAIN_LUP LETR_2 LSR A Shift 2 bits right to store LSR A 3 high bits in WRK_BYT1. ORA WRK_BYT1 JSR NXT_OBJ LDA STOREC Get byte again; ASL A shift 6 bits to left to ASL A store 2 low bits in ASL A WRK_BYT2. ASL A ASL A ASL A STA WRK_BYT2 JSR INC_PTR BNE MAIN_LUP LETR_3 ASL A 1 bit to left ORA WRK_BYT2 STA WRK_BYT2 JSR INC_PTR JSR GET_CHAR JSR CODABL CMP #32 Converted? BCS LTR3_DN If not, leave bit 0 clear LDA #1 If next char is codable, set ORA WRK_BYT2 bit 0 of WRK_BYT2 STA WRK_BYT2 LTR3_DN LDA WRK_BYT2 JSR NXT_OBJ LDA #0 STA LETR_NUM Reset LETR_NUM STA WRK_BYT1 0 out working bytes in case STA WRK_BYT2 they're saved by UN_CODED. JMP MAIN_LUP UN_CODED STA STOREC POKE FROM_ML,0 Clear from-MAIN_LUP flag LDA LETR_NUM Are we in the middle of BEQ UN_CDD3 coding working bytes? CMP #2 Yes; WRK_BYT1 already saved? BEQ UN_CDD2 LDA WRK_BYT1 JSR NXT_OBJ UN_CDD2 LDA WRK_BYT2 JSR NXT_OBJ UN_CDD3 LDA #%10000000 STA HILO_ORA LDA #0 STA LETR_NUM Reset LETR_NUM STA WRK_BYT1 0 out working bytes in case STA WRK_BYT2 they're saved by UN_CODED. JSR INC_PTR Get next character to see JSR GET_CHAR if this one should be high. JSR CODABL CMP #32 Converted? BCS HI_ASCII No, so current char. is high LDA #0 STA HILO_ORA HI_ASCII LDA STOREC Set hi bit if next char is ORA HILO_ORA uncodable. JSR NXT_OBJ JMP MAIN_LUP Get next character *======================================= * Subroutines for main program *======================================= *-------------------------------- * Get a character; skip controls *-------------------------------- GET_CHAR LDA (PTR),Y Get a character BEQ ZR_RCHED If a 0, handle it AND #%01111111 In case high ASCII TXT CMP #13 <return>? BEQ CHAR_GOT CMP #32 Control character? BCS CHAR_GOT JSR INC_PTR BNE GET_CHAR If so, skip it; get next CHAR_GOT RTS ZR_RCHED ANOP LDA MR_AHED Is there more text? BNE ZR_RCHD2 If so, go get next segment, BIT FROM_ML If not, check if we're coming BPL CHAR_GOT from MAIN_LUP. If not, return BMI DATS_ALL If so, LETR_NUM ok for exit ZR_RCHD2 STX STOREX JSR SEG_READ LDX STOREX JMP GET_CHAR and continue. DATS_ALL ANOP End reached; we're outa here PLA Pop stack, PLA LDA LETR_NUM and save any bytes BEQ DATS_AL3 we're already coding. CMP #2 WRK_BYT1 already saved? BEQ DATS_AL2 LDA WRK_BYT1 JSR NXT_OBJ DATS_AL2 LDA WRK_BYT2 JSR NXT_OBJ DATS_AL3 LDA #COM STA FILE_TYP Reset file type for PRNT_TYP JMP DONE *------------------------------- * See if character is codable *------------------------------- CODABL ANOP MSB OFF CMP #'a' Less than 'a'? if so, check BCC EXTRAS for the other codable chars. CMP #'{' BCS NOT_CDBL Greater than z; not codable SEC Lower case character; SBC #96 convert it to 1 to 26 and RTS return. EXTRAS ANOP PHA LDA #27 Set ex_code to 27 for space STA EX_CODE PLA CMP #' ' BEQ EX_FOUND INC EX_CODE Inc ex_code to 28 for comma CMP #',' BEQ EX_FOUND INC EX_CODE To 29 for apostrophe CMP #39 (apostrophe) BEQ EX_FOUND INC EX_CODE To 30 for period CMP #'.' BEQ EX_FOUND INC EX_CODE To 31 for <return> CMP #13 BNE NOT_CDBL EX_FOUND LDA EX_CODE NOT_CDBL RTS MSB ON *------------------------------- * Put byte into object buffer; * Write to file if full *------------------------------- NXT_OBJ STA OBJ_BUF,X INX BEQ WRT_OBJ If buffer full, write it to RTS object file; else return. WRT_OBJ ANOP LDA #0 Set default request_count STA WRIT_PL+4 to #$100 LDA #1 STA WRIT_PL+5 TXA BEQ DO_WRT If X=0, leave default. Else, STX WRIT_PL+4 X holds low byte of request LDA #0 count; high byte is 0. STA WRIT_PL+5 DO_WRT JSR MLI DC H'CB' Code for write DC A'WRIT_PL' BEQ WRTOBJDN No error JMP ERR_HAND WRTOBJDN LDX #0 RTS *------------------------------- * "Done" message *------------------------------- DONE ANOP Write remainder of object TXA buffer into file, unless BEQ DONE2 it's empty (X=0). JSR WRT_OBJ DONE2 JSR CLOSE Close both files JSR G_F_I Get and print file type, VTAB 18 JSR CROUT JSR PRNT_TYP size. JSR PRINT DC H'8D 8D',C' Done!',H'8D' DC C' Press <return> to process another' DC C' file, <esc> to quit. ',H'00' AGN_GET JSR KEYPRESS CMP #$8D BNE AGN_GET2 JMP INIT <return>; get new file names AGN_GET2 CMP #ESC <esc>? BNE AGN_GET JSR UP <esc> pressed; STRTPRMT JSR CLR_BTM erase this prompt JSR PRINT DC H'8D',C' Run STARTUP program? Y/N Y' DC H'08 00' JSR KEYPRESS CMP #$8D Return = Yes BEQ DO_STRT AND #$DF CMP #'Y' BNE QUIT DO_STRT POKE STORE,0 DO_STRT2 LDX #8 START_LP LDA STARTUP,X STA INBUF,X DEX BPL START_LP JSR DOSCMD LDA STORE Check & set flag to avoid BNE QUIT inf. loop. POKE STORE,1 LDX #7 Won't return from RUN DOSCMD PRFX_LP LDA PRFX,X unless it couldn't find the STA INBUF,X default prefix (or STARTUP). DEX If this happens, clear BPL PRFX_LP prefix & try again. JSR DOSCMD JMP DO_STRT2 QUIT TAB80 1 <esc> pressed; JSR CLR_BTM erase this prompt JMP BAILOUT and quit. *======================================= * AWP file conversion subroutines *======================================= *--------------------------------------- * Execute a Set_Mark to skip data bytes *--------------------------------------- AWP_SET ANOP LDA #0 Skip over 300 data bytes STA MARK_PL+4 LDA #$01 STA MARK_PL+3 LDA #$2C STA MARK_PL+2 Position of $00 01 2C (300) JMP SET_MARK *======================================= * Main AWP conversion routine *======================================= AWP_CON ANOP LDA #<MAINBUF Init pointers STA PTR STA AUX_PTR LDA #>MAINBUF STA AUX_PTR+1 STA PTR+1 SCAN_AWP ANOP LDY #1 Get byte +001 LDA (AUX_PTR),Y BEQ TXT_LINE If a 0, it's a text record CMP #$D0 A <return> line? BNE AWPENDMK JSR EMB_RET If so, go put it in, JSR AWP_NXTL BNE SCAN_AWP continue. AWPENDMK CMP #$FF End of file marker? BEQ END_AWP Exit if so JSR AWP_NXTL Continue if not BNE SCAN_AWP TXT_LINE ANOP LDY #2 Get byte +002 LDA (AUX_PTR),Y CMP #$FF Is this a tab-ruler line? BNE TXT_LIN1 LDY #0 If so, skip over the line: CLC LDA (AUX_PTR),Y Get byte +000 (length byte) ADC #2 add 2, CLC ADC AUX_PTR add this to pointers, STA AUX_PTR LDA AUX_PTR+1 ADC #0 STA AUX_PTR+1 BNE SCAN_AWP continue with next line. TXT_LIN1 INY Get byte +003 LDA (AUX_PTR),Y If high bit set, line ends PHP with <ret>; save N flag AND #$7F Clearing high bit gives STA AWP_LEN length byte; save it. JSR AWP_RDLN Go read line into buffer. POKE AWP_RET,0 Clear line-end-<ret> flag PLP Get back N flag, BPL TXT_LINQ JSR EMB_RET embed return if needed, TXT_LINQ JMP SCAN_AWP Continue scan *---------------------------- * End of AWP file found *---------------------------- END_AWP ANOP LDY #0 Put in end-of-file marker TYA STA (PTR),Y LDA #<MAINBUF Reset pointers STA PTR LDA #>MAINBUF STA PTR+1 RTS Return *================================= * Subroutines for AWP conversion *================================= *--------------------------------------- * Move line from AWP buf. to ASCII buf. *--------------------------------------- AWP_RDLN ANOP CLC LDA AUX_PTR ADC #4 Text starts at byte +004 STA AUX_PTR LDA AUX_PTR+1 ADC #0 STA AUX_PTR+1 LDY #0 LDA (AUX_PTR),Y CMP #$16 Does line start with a tab? BNE AWP_RL1 LDA AWP_RET If so, make sure previous BNE AWP_RL1 line ends with a <ret>. JSR EMB_RET AWP_RL1 LDA (AUX_PTR),Y Get a byte from AWP CMP #$0B If sticky-space, BEQ AWP_MKSP CMP #$17 or tab-space, BNE PUT_AWP AWP_MKSP LDA #$20 convert to ASCII space. PUT_AWP CMP #$20 Unless it's another BCC AWP_NXTC special code, STA (PTR),Y put it into ASCII buffer. JSR INC_PTR AWP_NXTC JSR INC_APTR DEC AWP_LEN Dec length byte BNE AWP_RL1 until whole line moved. *--------------------------------------- * If necessary, clip off end of AWP file *--------------------------------------- LDA MR_AHED Is there more to this file BEQ AWP_RLQ than this buffer-full? CLC LDA AUX_PTR+1 If so, are we within ADC #1 $100 of buffer-end? CMP BUF_END+1 BCC AWP_RLQ LDY #1 If so, make the next line LDA #$FF a dummy EOF cmd. line. STA (AUX_PTR),Y SEC LDA BUF_END Get & store the difference SBC AUX_PTR between our new end-of- STA STORE_AC buffer-full and the actual LDA BUF_END+1 end of buffer. SBC AUX_PTR+1 STA STORE_AC+1 SEC LDA SRC_MARK Subtract this from the SBC STORE_AC saved source-mark. STA SRC_MARK LDA SRC_MARK+1 SBC STORE_AC+1 STA SRC_MARK+1 LDA SRC_MARK+2 SBC #0 STA SRC_MARK+2 AWP_RLQ RTS Continue with next line *------------------------------- * skip over cmd. or <ret> line *------------------------------- AWP_NXTL JSR INC_APTR JMP INC_APTR *------------------------------- * AWP embedded return handler *------------------------------- EMB_RET LDY #0 LDA #$0D ASCII return STA AWP_RET Clear line-end-<ret> flag STA (PTR),Y Into ASCII formated buffer JMP INC_PTR Inc pointers, return. ******************************** * Decompress compressed file ******************************** DECOMP ANOP LDX #0 Init X & Y; pointers are LDY #0 already set. JSR INC_COM3 Dec. bytes-used counter LDA (PTR),Y Get first byte BNE UNCODED2 If not 0, it's uncoded ASCII DECD_LUP ANOP LETER_1 JSR INC_COM LDA (PTR),Y LSR A LSR A LSR A JSR PUT_LTER LETER_2 LDA (PTR),Y AND #%00000111 ASL A ASL A STA STOREC JSR INC_COM LDA (PTR),Y LSR A LSR A LSR A LSR A LSR A LSR A ORA STOREC JSR PUT_LTER LETER_3 LDA (PTR),Y AND #%00111111 LSR A JSR PUT_LTER LDA (PTR),Y AND #%00000001 BNE DECD_LUP If bit 0 clear, next byte * is uncoded; fall through. UNCODED ANOP JSR INC_COM UNCODED2 LDA (PTR),Y Get character (uncoded) AND #%01111111 Clear high bit JSR NXT_OBJ Put into object buffer LDA (PTR),Y Hi bit set on uncoded byte? BMI UNCODED If so, next is uncoded too JMP DECD_LUP *------------------------------- * Inc. compressed pointers; * check if file end reached *------------------------------- INC_COM ANOP LDA READ_IN Check if buffer used up ORA READ_IN+1 BNE INC_COM2 If both = 0 buffer used up. LDA MR_AHED Anything left in file? BEQ COM_END No JSR SEG_READ Yes; get another buffer-full JMP INC_COM3 Don't inc ptr's after read INC_COM2 JSR INC_PTR Inc loading buffer's ptr's INC_COM3 LDA READ_IN Dec amount read in as counter BNE DEC_RIL If low byte=0, dec high DEC READ_IN+1 byte first. DEC_RIL DEC READ_IN RTS COM_END ANOP PLA Pop stack PLA LDA #TXT STA FILE_TYP Reset file type for PRNT_TYP JMP DONE Go to main Compressor's DONE *----------------------------------------- * Finish decoding character, put in buffer *----------------------------------------- PUT_LTER ANOP BNE PUT_LTR2 If it's a 0, just return RTS PUT_LTR2 CMP #27 One of the extra characters? BCC NOT_EXT SEC If so, get char out of table SBC #27 TAY LDA EXT_LET,Y LDY #0 Reset Y, JMP NXT_OBJ and put char. into buffer. NOT_EXT CLC ADC #96 Decode to low ASCII JMP NXT_OBJ *------------------------------- * MLI Parameter lists *------------------------------- CLOSE_PL DC H'01' DC H'00' MARK_PL DC H'02' DC H'01' DS 3 OPEN_PL DC H'03' DS 5 READ_PL DC H'04' DC H'01' DC A'MAINBUF' DS 4 DEST_PL DC H'01' DC A'INP_BUF' CREAT_PL DC H'07' CREATE Parm list: DC A'INP_BUF' DC H'C3' Access code for "unlocked" DS 1 File type put here DC H'0B B0' AUX_TYPE $B00B DC H'01' STORAGE_TYPE standard DS 4 Time & date put here WRIT_PL DC H'04' DC H'01' DC A'OBJ_BUF' DS 4 PARMLST DS $12 General use parm list *=============================== * Buffers, flags, etc. *=============================== IIPLS DS 1 Flag that on II+ MAINBUF EQU $2100 Buffer for source file OBJ_BUF EQU $2000 1 pg. buffer for object file BUF_END DS 2 Gets end of buffer STORE DS 1 Use to store various stuff STOREC DS 1 Store char. in comp. & decomp STOREX DS 1 Use to store X register STORE_AC DS 2 Storage for AWP_CON AWP_LEN DS 1 AWP line length byte AWP_RET DS 1 Flag: AWP line ends w/ <ret> SRC_NAM DS 49 Holds source name to compare INP_BUF DS 49 Holds input file name READ_1 DS 1 Flag: use input for 1 key press INP_MINC DS 1 Min. char. value in INPUT SRC_OBJ DS 1 Holds 'O' if in GET_OBJ ERROR DS 1 Error flag for screen clear CATFLG DS 1 Screen cleared for catalog FILE_TYP DS 1 Gets file type MR_AHED DS 1 Flag that more text is ahead EX_CODE DS 1 Holds code of extra char. HILO_ORA DS 1 Hold mask to set(?) hi bit LETR_NUM DS 1 Gets 1, 2 or 3 - source char WRK_BYT1 DS 1 Two working bytes that get WRK_BYT2 DS 1 three encoded characters. FROM_ML DS 1 Flag that coming from MAIN_LUP SEGMENTS DS 1 Flag that file is multi-seg. NO_SWAPS DS 1 Flag that disks not swapped YES_SWAP DS 1 Flag that disks being swapped SRC_MARK DS 3 Holds source GET_MARK OBJ_MARK DS 3 Holds object GET_MARK READ_IN DS 2 Amount read in for DECOMP LDNG_DGT DS 1 Flag for print # of blocks *=============================== * Strings *=============================== CTLG DC C'CATALOG ' PREFX DC C'PREFIX,S ,D ',H'8D' PR3 DC C'PR#3',H'8D' STARTUP DC C'-STARTUP',H'8D' PRFX DC C'PREFIX/',H'8D' EXT_LET DC H'20 2C 27 2E 0D' For DECOMP END